Especial Multimedia/Especial Multimedia.iso/Multimed/Prg/WAVPLUS.ZIP/CDPLAY.WD_/CDPLAY.WD

Text File | 1997-09-14 | 11KB | 386 lines

VERSION 2.00
Begin Form CDplayer
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "CD Player"
   ClientHeight    =   5880
   ClientLeft      =   2520
   ClientTop       =   1485
   ClientWidth     =   5820
   ControlBox      =   0   'False
   Height          =   6285
   Icon            =   CDPLAY.FRX:0000
   Left            =   2460
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5880
   ScaleWidth      =   5820
   Top             =   1140
   Width           =   5940
   Begin Timer Timer1
      Interval        =   500
      Left            =   5520
      Top             =   5580
   End
   Begin CommandButton CmdAll
      BackColor       =   &H00C0C0C0&
      Caption         =   "Play &All"
      Height          =   495
      Left            =   300
      TabIndex        =   2
      Top             =   4740
      Width           =   2595
   End
   Begin CheckBox CheckLoop
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Continuous Play"
      Height          =   315
      Left            =   3000
      TabIndex        =   6
      Top             =   2520
      Width           =   2595
   End
   Begin CommandButton CmdOkay
      BackColor       =   &H00C0C0C0&
      Caption         =   "O &K A Y"
      Height          =   495
      Left            =   300
      TabIndex        =   5
      Top             =   5280
      Width           =   5295
   End
   Begin CommandButton CmdNew
      BackColor       =   &H00C0C0C0&
      Caption         =   "Reset or Read &New CD"
      Height          =   495
      Left            =   3000
      TabIndex        =   4
      Top             =   4740
      Width           =   2595
   End
   Begin CommandButton CmdStop
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Stop\Pause"
      Height          =   495
      Left            =   3000
      TabIndex        =   3
      Top             =   4200
      Width           =   2595
   End
   Begin CommandButton CmdPlay
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Play Selection(s)"
      Height          =   495
      Left            =   300
      TabIndex        =   1
      Top             =   4200
      Width           =   2595
   End
   Begin ListBox List1
      Height          =   3345
      Left            =   240
      MultiSelect     =   1  'Simple
      TabIndex        =   0
      Top             =   660
      Width           =   2595
   End
   Begin Label LblInfo
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "00:00:00"
      ForeColor       =   &H00800000&
      Height          =   255
      Index           =   3
      Left            =   4440
      TabIndex        =   10
      Top             =   1560
      Width           =   1155
   End
   Begin Label LblInfo
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "00:00:00"
      ForeColor       =   &H00000080&
      Height          =   255
      Index           =   2
      Left            =   4440
      TabIndex        =   15
      Top             =   1320
      Width           =   1155
   End
   Begin Label LblInfo
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "0"
      ForeColor       =   &H00800000&
      Height          =   255
      Index           =   1
      Left            =   4440
      TabIndex        =   14
      Top             =   1080
      Width           =   1155
   End
   Begin Label LblTopic
      BackStyle       =   0  'Transparent
      Caption         =   "Length:"
      ForeColor       =   &H00800000&
      Height          =   255
      Index           =   3
      Left            =   3000
      TabIndex        =   13
      Top             =   1560
      Width           =   1155
   End
   Begin Label LblTopic
      BackStyle       =   0  'Transparent
      Caption         =   "Time:"
      ForeColor       =   &H00000080&
      Height          =   255
      Index           =   2
      Left            =   3000
      TabIndex        =   12
      Top             =   1320
      Width           =   1155
   End
   Begin Label LblTopic
      BackStyle       =   0  'Transparent
      Caption         =   "Track:"
      ForeColor       =   &H00800000&
      Height          =   255
      Index           =   1
      Left            =   3000
      TabIndex        =   11
      Top             =   1080
      Width           =   1155
   End
   Begin Label LblTopic
      BackStyle       =   0  'Transparent
      Caption         =   "Status:"
      ForeColor       =   &H00000080&
      Height          =   255
      Index           =   0
      Left            =   3000
      TabIndex        =   9
      Top             =   840
      Width           =   1155
   End
   Begin Label LblInfo
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "not ready"
      ForeColor       =   &H00000080&
      Height          =   255
      Index           =   0
      Left            =   4440
      TabIndex        =   8
      Top             =   840
      Width           =   1155
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Click once on each selection that you want to play."
      ForeColor       =   &H00800000&
      Height          =   435
      Left            =   240
      TabIndex        =   7
      Top             =   180
      Width           =   2595
   End
End
Dim NewDisk%

Dim PlayItNow%

Dim PlayList$()

Dim UserStop%

Sub CmdAll_Click ()
    If List1.ListCount = 0 Then
        MsgBox "There are no audio tracks available."
        Exit Sub
        End If

    For x = 0 To List1.ListCount - 1
        List1.Selected(x) = True
        Next x

    List1.Refresh
    CmdPlay_Click
End Sub

Sub CmdNew_Click ()
    Screen.MousePointer = 11
    List1.Clear : List1.Refresh
    NewDisk% = True
    ReturnString$ = Space$(255)
    CDstop ReturnString$

    ReturnString$ = Space$(255)
    CDstatusInserted ReturnString$
    status$ = Trim$(TrimAtNull(ReturnString$))
    If status$ = "false" Then
        Screen.MousePointer = 0
        MsgBox "The CD drive is empty!"
        Exit Sub
        End If

    ReturnString$ = Space$(255)
    CDstatusMode ReturnString$
    status$ = Trim$(TrimAtNull(ReturnString$))
    If status$ = "not ready" Then
        Screen.MousePointer = 0
        MsgBox "Can not read CD drive!"
        Exit Sub
        End If

    ReturnString$ = Space$(255)
    CDstatusTracks ReturnString$
    status$ = Trim$(TrimAtNull(ReturnString$))
    If status$ = "1" Then
        Screen.MousePointer = 0
        MsgBox "Can not play a data CD!"
        Exit Sub
        End If

    TrackCount% = Val(status$)
    ReDim PlayList(TrackCount%)
    For x = 1 To TrackCount%
        List1.AddItem "Track " + Format$(x)
        PlayList(x) = "0,0" 'track,played
        Next x


    LblInfo(0).Caption = "stopped"
    LblInfo(1).Caption = "0"
    LblInfo(2).Caption = "00:00:00"
    LblInfo(3).Caption = "00:00:00"
    List1.Enabled = True
    CmdAll.Enabled = True
    UserStop% = False

    Screen.MousePointer = 0
End Sub

Sub CmdOkay_Click ()
    CmdStop_Click
    Timer1.Enabled = False
    Unload Me
End Sub

Sub CmdPlay_Click ()
    If List1.ListCount = 0 Then
        MsgBox "There are no audio tracks available."
        Exit Sub
        End If

    If UserStop% = True Then
        UserStop% = False
        PlayItNow% = True
        Exit Sub
        End If

    counter% = 1
    For x = 1 To List1.ListCount
        If List1.Selected(x - 1) = True Then
            PlayList(counter%) = Format$(x) + ",0"
            counter% = counter% + 1
            End If
        Next x

    If counter% = 1 Then
        MsgBox "No tracks are selected!"
        Exit Sub
        End If

    List1.Enabled = False
    CmdAll.Enabled = False
    PlayItNow = True
End Sub

Sub CmdStop_Click ()
    PlayItNow = False
    UserStop% = True
    ReturnString$ = Space$(255)
    CDstop ReturnString$
    LblInfo(2).Caption = "00:00:00"

    'reset played flag for current track (now play will start here)
    For x = List1.ListCount To 1 Step -1
        pos% = InStr(PlayList(x), ",")
        track% = Val(Left$(PlayList(x), pos% - 1))
        Played% = Val(Right$(PlayList(x), Len(PlayList(x)) - pos%))
        If track% = 0 GoTo CheckNext
        If Played% = -1 Then
            PlayList(x) = Format$(track%) + ",0"
            Exit For
            End If
CheckNext:
        Next x

End Sub

Sub Form_Load ()
    FormCenterScreen Me
    DisplayedCDplayer = True
    CmdNew_Click

    Screen.MousePointer = 0
End Sub

Sub Form_Paint ()
    DoForm3D Me, "raised", 2, 0
    DoForm3D Me, "sunken", 2, 2

    DoControl3D List1, "sunken", 1
End Sub

Sub Form_Unload (Cancel As Integer)
    DisplayedCDplayer = False
End Sub

Sub Timer1_Timer ()
    ReturnString$ = Space$(255)
    CDstatusMode ReturnString$
    PlayStatus$ = Trim$(TrimAtNull(ReturnString$))
    here% = DoEvents()
    If LblInfo(0).Caption <> PlayStatus$ Then LblInfo(0).Caption = PlayStatus$

    ReturnString$ = Space$(255)
    CDstatusPosition ReturnString$
    status$ = Trim$(TrimAtNull(ReturnString$))
    pos% = InStr(status$, ":")
    status$ = Right$(status$, Len(status$) - pos%)
    If PlayStatus$ <> "stopped" Then LblInfo(2).Caption = status$

    If PlayStatus$ = "playing" Then Exit Sub
    If PlayItNow% = True Then
        If PlayStatus$ = "stopped" Then
            For x = 1 To List1.ListCount
                pos% = InStr(PlayList(x), ",")
                track% = Val(Left$(PlayList(x), pos% - 1))
                Played% = Val(Right$(PlayList(x), Len(PlayList(x)) - pos%))
                If track% <> 0 And Played% = 0 Then
                    PlayList(x) = Format$(track%) + ",-1"
                    ReturnString$ = Space$(255)
                    CDstatusTrackLength ReturnString$, track%
                    ThisLen$ = Trim$(TrimAtNull(ReturnString$))
                    LblInfo(3).Caption = ThisLen$
                    LblInfo(1).Caption = Format$(track%)
                    ReturnString$ = Space$(255)
                    CDplay ReturnString$, track%
                    Exit Sub
                    End If
                Next x
            If CheckLoop.Value = 1 Then
                UserStop = False
                PlayItNow% = False
                CmdPlay_Click
                End If
            End If
        End If
End Sub